# $Id: sql.tcl 7557b5d4d82b 2012/12/02 09:07:16 pgurumur $
# Copyright (c) 2009 Prabhu Gurumurthy  <pgurumur@gmail.com>
# 
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#

# version "$Revision: 7557b5d4d82b $"
# author "$Author: pgurumur $"

package require sqlite3
package require mysqltcl 3.0
package require stdlib

namespace eval sql {
   namespace export sql
   namespace export mysql
   set version 1.1
   set dbh ""
   set type ""
}

proc sql::sqlite { database } {
   global dbh type

   if {[string length $database]} {
      sqlite3 $dbh $database
      set type "sqlite"
   }
}

proc sql::mysql { database host { username "" } { password "" } } {
   global tcl_platform dbh 
   global type

   set retval ""
   set user ""
   set pass ""
   set flag [string length $database]
   set flag [expr $flag && [string length $host]]

   if {[string length $username]} {
      set user $username
   } else {
      set user $tcl_platform(user)
   }

   if {[string length $password]} {
      set pass $password
   }

   if {[catch {set retval [mysql::connect -host $host -user $user -password $pass -db $database]} err]} {
      error $err
   } else {
      set dbh $retval
      set type "mysql"
   }
}

proc sql::close {} {
   global dbh type
   if {[string length $dbh]} {
      if {$type == "sqlite"} {
         $dbh close
      } else {
         mysql::close $dbh
      }

      set dbh ""
      set type ""
   }
}

proc sql::gettype {} {
   global type
   return $type
}

proc sql::execute { statement { select 0 } } {
   global dbh type
   set retval [list]
   if {$select == 1} {
      if {$type == "mysql"} {
         if {[mysql::ping $dbh]} {
            if {[ catch { set query [mysql::query $dbh $statement ] } err]} {
               error $err
            } else {
               while {[set row [::mysql::fetch $query]] != ""} {
                  lappend retval $row
               }
            
               mysql::endquery $query
            }
         }
      } elseif {$type == "sqlite"} {
         if {[catch {$dbh eval $statement} err]} {
            error $err
         } 
      }
   } else {
      if {$type == "mysql"} {
         if {[catch {mysql::exec $dbh $statement} err]} {
            error $err
         }
      } elseif {$type == "sqlite"} {
         if {[catch {$dbh eval $statement} err]} {
            error $err
         }
      }
   }

   return $retval
}

proc sql::? {} { lsort [info procs ::sql::*] }
package provide sql $sql::version
